home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / ftpser1a / ftp_srv.frm < prev    next >
Text File  |  1999-10-04  |  13KB  |  383 lines
  1. VERSION 5.00
  2. Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
  3. Begin VB.Form FtpServ 
  4.    Appearance      =   0  'Flat
  5.    AutoRedraw      =   -1  'True
  6.    BackColor       =   &H00C0C0C0&
  7.    BorderStyle     =   1  'Fixed Single
  8.    Caption         =   "FTP SERVER"
  9.    ClientHeight    =   4575
  10.    ClientLeft      =   1455
  11.    ClientTop       =   3105
  12.    ClientWidth     =   8355
  13.    BeginProperty Font 
  14.       Name            =   "MS Sans Serif"
  15.       Size            =   8.25
  16.       Charset         =   0
  17.       Weight          =   700
  18.       Underline       =   0   'False
  19.       Italic          =   0   'False
  20.       Strikethrough   =   0   'False
  21.    EndProperty
  22.    ForeColor       =   &H80000008&
  23.    Icon            =   "FTP_SRV.frx":0000
  24.    LinkTopic       =   "FtpServ"
  25.    MaxButton       =   0   'False
  26.    MinButton       =   0   'False
  27.    PaletteMode     =   1  'UseZOrder
  28.    ScaleHeight     =   4575
  29.    ScaleWidth      =   8355
  30.    StartUpPosition =   2  'CenterScreen
  31.    Begin VB.TextBox UsrCnt 
  32.       Height          =   285
  33.       Left            =   3240
  34.       TabIndex        =   5
  35.       Text            =   "0"
  36.       Top             =   3960
  37.       Width           =   855
  38.    End
  39.    Begin VB.CommandButton EndCmd 
  40.       Caption         =   "Close Connection"
  41.       Height          =   375
  42.       Left            =   120
  43.       TabIndex        =   3
  44.       Top             =   3840
  45.       Width           =   1935
  46.    End
  47.    Begin VB.Frame StatFrame 
  48.       Caption         =   "Status Window"
  49.       Height          =   3735
  50.       Left            =   120
  51.       TabIndex        =   1
  52.       Top             =   0
  53.       Width           =   8055
  54.       Begin VB.ListBox LogWnd 
  55.          Appearance      =   0  'Flat
  56.          BackColor       =   &H00000000&
  57.          BeginProperty Font 
  58.             Name            =   "MS Serif"
  59.             Size            =   6.75
  60.             Charset         =   0
  61.             Weight          =   400
  62.             Underline       =   0   'False
  63.             Italic          =   0   'False
  64.             Strikethrough   =   0   'False
  65.          EndProperty
  66.          ForeColor       =   &H0000FF00&
  67.          Height          =   3165
  68.          ItemData        =   "FTP_SRV.frx":030A
  69.          Left            =   120
  70.          List            =   "FTP_SRV.frx":030C
  71.          TabIndex        =   2
  72.          Top             =   240
  73.          Width           =   7815
  74.       End
  75.    End
  76.    Begin ComctlLib.StatusBar StatusBar 
  77.       Align           =   2  'Align Bottom
  78.       Height          =   255
  79.       Left            =   0
  80.       TabIndex        =   0
  81.       Top             =   4320
  82.       Width           =   8355
  83.       _ExtentX        =   14737
  84.       _ExtentY        =   450
  85.       SimpleText      =   ""
  86.       _Version        =   327682
  87.       BeginProperty Panels {0713E89E-850A-101B-AFC0-4210102A8DA7} 
  88.          NumPanels       =   3
  89.          BeginProperty Panel1 {0713E89F-850A-101B-AFC0-4210102A8DA7} 
  90.             Object.Width           =   10654
  91.             MinWidth        =   10654
  92.             Object.Tag             =   ""
  93.          EndProperty
  94.          BeginProperty Panel2 {0713E89F-850A-101B-AFC0-4210102A8DA7} 
  95.             Style           =   6
  96.             Object.Width           =   2187
  97.             MinWidth        =   2187
  98.             TextSave        =   "10/05/1999"
  99.             Object.Tag             =   ""
  100.          EndProperty
  101.          BeginProperty Panel3 {0713E89F-850A-101B-AFC0-4210102A8DA7} 
  102.             Style           =   5
  103.             Object.Width           =   1764
  104.             MinWidth        =   1764
  105.             TextSave        =   "1:55 AM"
  106.             Object.Tag             =   ""
  107.          EndProperty
  108.       EndProperty
  109.    End
  110.    Begin VB.Timer Timer1 
  111.       Enabled         =   0   'False
  112.       Index           =   4
  113.       Interval        =   50
  114.       Left            =   7200
  115.       Top             =   3840
  116.    End
  117.    Begin VB.Timer Timer1 
  118.       Enabled         =   0   'False
  119.       Index           =   3
  120.       Interval        =   50
  121.       Left            =   6720
  122.       Top             =   3840
  123.    End
  124.    Begin VB.Timer Timer1 
  125.       Enabled         =   0   'False
  126.       Index           =   2
  127.       Interval        =   50
  128.       Left            =   6240
  129.       Top             =   3840
  130.    End
  131.    Begin VB.Timer Timer1 
  132.       Enabled         =   0   'False
  133.       Index           =   1
  134.       Interval        =   50
  135.       Left            =   5760
  136.       Top             =   3840
  137.    End
  138.    Begin VB.Timer Timer1 
  139.       Enabled         =   0   'False
  140.       Index           =   0
  141.       Interval        =   50
  142.       Left            =   5280
  143.       Top             =   3840
  144.    End
  145.    Begin VB.Label Label1 
  146.       Caption         =   "# of Users"
  147.       BeginProperty Font 
  148.          Name            =   "MS Sans Serif"
  149.          Size            =   8.25
  150.          Charset         =   0
  151.          Weight          =   400
  152.          Underline       =   0   'False
  153.          Italic          =   0   'False
  154.          Strikethrough   =   0   'False
  155.       EndProperty
  156.       Height          =   255
  157.       Left            =   2280
  158.       TabIndex        =   4
  159.       Top             =   3960
  160.       Width           =   975
  161.    End
  162.    Begin VB.Menu mSetup 
  163.       Caption         =   "Setup"
  164.    End
  165. End
  166. Attribute VB_Name = "FtpServ"
  167. Attribute VB_GlobalNameSpace = False
  168. Attribute VB_Creatable = False
  169. Attribute VB_PredeclaredId = True
  170. Attribute VB_Exposed = False
  171.  
  172. Private Sub EndCmd_Click()
  173. Dim i As Integer
  174.   For i = 1 To MAX_N_USERS    'close all connection
  175.     If users(i).control_slot <> INVALID_SOCKET Then
  176.       retf = closesocket(users(i).control_slot) 'close control slot
  177.     End If
  178.     If users(i).data_slot <> INVALID_SOCKET Then
  179.       retf = closesocket(users(i).data_slot) 'close data slot
  180.     End If
  181.   Next
  182.   retf = closesocket(ServerSlot)
  183.   If SaveProfile(App.Path & "\ftp_srv.ini", True) Then
  184.   End If
  185.   Unload Me
  186. End Sub
  187.  
  188. Private Sub Form_Load()
  189. Dim i As Integer
  190. Dim hdr As String, item As String
  191.   '--- Initialization
  192.   'an FTP command is terminated by Carriage_Return & Line_Feed
  193.   'possible sintax errors in FTP commands
  194.   sintax_error_list(0) = "200 Command Ok."
  195.   sintax_error_list(1) = "202 Command not implemented, superfluous at this site."
  196.   sintax_error_list(2) = "500 Sintax error, command unrecognized."
  197.   sintax_error_list(3) = "501 Sintax error in parameters or arguments."
  198.   sintax_error_list(4) = "502 Command not implemented."
  199.   sintax_error_list(6) = "504 Command not implemented for that parameter."
  200.   'initializes the list which contains the names,
  201.   'passwords, access rights and default directory
  202.   'recognized by the server
  203.   If LoadProfile(App.Path & "\ftp_srv.ini") Then
  204.     '
  205.   Else
  206.     StatusBar.Panels(1) = "Error Loading Ini File!"
  207.   End If
  208.   'initializes the records which contain the
  209.   'informations on the connected users
  210.   For i = 1 To MAX_N_USERS
  211.     users(i).list_index = 0
  212.     users(i).control_slot = INVALID_SLOT
  213.     users(i).data_slot = INVALID_SLOT
  214.     users(i).IP_address = ""
  215.     users(i).Port = 0
  216.     users(i).data_representation = "A"
  217.     users(i).data_format_ctrls = "N"
  218.     users(i).data_structure = "F"
  219.     users(i).data_tx_mode = "S"
  220.     users(i).cur_dir = ""
  221.     users(i).state = 0
  222.     users(i).full = False
  223.   Next
  224.   
  225.   OldWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
  226.  
  227.   vbWSAStartup
  228.   
  229.   'begins SERVER mode on port 21
  230.   ServerSlot = ListenForConnect(21, hWnd)
  231.   If ServerSlot > 0 Then
  232.     StatusBar.Panels(1) = Description
  233.   Else
  234.     StatusBar.Panels(1) = "Error Creating Listening Socket"
  235.   End If
  236. End Sub
  237.  
  238. Private Sub Form_Unload(Cancel As Integer)
  239.   SetWindowLong hWnd, GWL_WNDPROC, OldWndProc
  240.   vbWSACleanup
  241. End Sub
  242.  
  243. Private Sub mSetup_Click()
  244.   UserOpts.Show 1
  245. End Sub
  246.  
  247. Private Sub Timer1_Timer(index As Integer)
  248. Dim close_data_cnt As Integer
  249. Dim error_on_data_cnt As Integer
  250.  
  251. Select Case files_info(index).retr_stor
  252.   Case 0:  '--- R E T R  Command
  253.   If files_info(index).data_representation = "A" Then
  254.     If Not